home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE13 / CONSTRUC / ADDIN.DPR next >
Encoding:
Text File  |  1996-08-15  |  3.7 KB  |  161 lines
  1. library AddIn;
  2. uses
  3.   ShareMem, ExptIntf, ToolIntf, Menus, Forms, Dialogs, Classes;
  4.  
  5. { EXPERT TYPE DEFINITION }
  6.  
  7. Type
  8.   TBAddInExpert = class(TIExpert)
  9.   public
  10.     constructor Create; virtual;
  11.     destructor Destroy; override;
  12.  
  13.     function GetStyle: TExpertStyle; override;
  14.     function GetIDString: String; override;
  15.     function GetName: String; override;
  16.     function GetAuthor: String; override;
  17.  
  18.   protected
  19.     procedure OnClick(Sender: TIMenuItemIntf); virtual;
  20.  
  21.   private
  22.     MenuItem: TIMenuItemIntf;
  23.   end {TBAddInExpert};
  24.  
  25. { EXPERT SUPPORT FUNCTION }
  26.  
  27. procedure HandleException;
  28. begin
  29.   if Assigned(ToolServices) then
  30.     ToolServices.RaiseException(ReleaseException)
  31.   { Aplication.Handle := ToolServices.GetParentHandle; }
  32. end {HandleException};
  33.  
  34. { EXPERT IMPLEMENTATION }
  35.  
  36. constructor TBAddInExpert.Create;
  37. var Main: TIMainMenuIntf;
  38.     ToolsTools: TIMenuItemIntf;
  39.     Tools: TIMenuItemIntf;
  40. begin
  41.   inherited Create;
  42.   MenuItem := nil;
  43.   if ToolServices <> nil then
  44.   try
  45.     Main := ToolServices.GetMainMenu;
  46.     if Main <> nil then { we've got the main menu }
  47.     try
  48.       ToolsTools := Main.FindMenuItem('ViewPrjMgrItem'{ToolsToolsItem'});
  49.       if ToolsTools <> nil then { we've got the " Tools | Tools" item }
  50.       try
  51.         Tools := ToolsTools.GetParent;
  52.         if Tools <> nil then { we've got the Tools menu }
  53.         try
  54.           MenuItem := Tools.InsertItem(ToolsTools.GetIndex+1,
  55.                                       '&Dr.Bob''s Expert',
  56.                                        'DrBob','',
  57.                                         ShortCut(Ord('D'),[ssCtrl]),0,0,
  58.                                        [mfEnabled, mfVisible], OnClick)
  59.         finally
  60.           Tools.DestroyMenuItem
  61.         end
  62.       finally
  63.         ToolsTools.DestroyMenuItem
  64.       end
  65.     finally
  66.       Main.Free
  67.     end
  68.   except
  69.     HandleException
  70.   end
  71. end {Create};
  72.  
  73. destructor TBAddInExpert.Destroy;
  74. begin
  75.   try
  76.     if MenuItem <> nil then MenuItem.DestroyMenuItem;
  77.     inherited Destroy
  78.   except
  79.     HandleException
  80.   end
  81. end {Destroy};
  82.  
  83. function TBAddInExpert.GetStyle: TExpertStyle;
  84. begin
  85.   try
  86.     Result := esAddIn
  87.   except
  88.     HandleException
  89.   end
  90. end {GetStyle};
  91.  
  92. function TBAddInExpert.GetIDString: String;
  93. begin
  94.   try
  95.     Result := 'DrBob.AddIn.Expert'
  96.   except
  97.     HandleException
  98.   end
  99. end {GetIDString};
  100.  
  101. function TBAddInExpert.GetName: String;
  102. begin
  103.   try
  104.     Result := 'DrBob.AddIn.Expert'
  105.   except
  106.     HandleException
  107.   end
  108. end {GetName};
  109.  
  110. function TBAddInExpert.GetAuthor: String;
  111. begin
  112.   try
  113.     Result := 'Bob.Swart'
  114.   except
  115.     HandleException
  116.   end
  117. end {GetAuthor};
  118.  
  119.  
  120. procedure TBAddInExpert.OnClick(Sender: TIMenuItemIntf);
  121. begin
  122.   try
  123.     ShowMessage('Dr.Bob Says: Hello, World!'#10#10+
  124.                 'Thank you for reading my'#10+
  125.                 'Under Construction column'#10+
  126.                 'in The Delphi Magazine!')
  127.   except
  128.     HandleException
  129.   end
  130. end {OnClick};
  131.  
  132. { DLL EXPERT INTERFACE }
  133.  
  134. procedure DoneExpert;
  135. begin
  136. { ShowMessage(ParamStr(0)+' unloaded!') }
  137. end {DoneExpert};
  138.  
  139. function InitExpert(ToolServices: TIToolServices;
  140.                     RegisterProc: TExpertRegisterProc;
  141.                 var Terminate: TExpertTerminateProc): Boolean; stdcall;
  142. begin
  143.   try
  144.     Result := True;
  145.     ExptIntf.ToolServices := ToolServices; { Save! }
  146.     if ToolServices <> nil then
  147.       Application.Handle := ToolServices.GetParentHandle;
  148.     Terminate := DoneExpert;
  149.     Result := RegisterProc(TBAddInExpert.Create);
  150.   except
  151.     HandleException
  152.   end
  153. end {InitExpert};
  154.  
  155. exports
  156.   InitExpert name ExpertEntryPoint;
  157.  
  158. begin
  159. { ShowMessage(ParamStr(0)+' loaded!') }
  160. end.
  161.